home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Toolbox Classes / Serial < prev    next >
Text File  |  1993-05-12  |  4KB  |  134 lines
  1. \ serial - async serial driver support
  2. \  2/04/85  cbd Version 1
  3. \  9/04/86  cdn Eliminated redundant readnw: & writenw
  4. \  9/06/86  cdn Added bi-directional port usage
  5. \                Automatically send reset: in open:
  6. \  4/19/89    rfl    added break:
  7. \  6/13/89    rfl requires interval for pause
  8. \  3/14/90    rfl    added buffer:
  9. \  8/16/90    rfl    added baudrate: and XON:
  10. \ 10/09/90    rfl    added status: and bytesIn:
  11. \ 10/19/90    rfl    added flags and Device Control Record ptr
  12. \ 10/30/90    rfl    added DTR handshake (pin 6)
  13. \  5/12/93    rfl    set DTR false during Open: to take care of problem with powerbooks
  14.  
  15. Decimal
  16.  
  17. \ define serial i/o port object
  18. :CLASS Port  <Super PBDrvr
  19.  
  20.     Int        thePort        \  0=modem, 1=printer
  21.     Int        Direction    \  0=input, 1=output, 2=both
  22.     Int        Config        \ bits, parity, speed
  23.     Int        inRef        \ input IORefNum
  24.     Int        outRef        \ output IORefNum
  25.  
  26.     \ ( port# direction -- )
  27.     :M  INIT:  put: direction  put: thePort   ;M
  28.  
  29.     \ ( config -- )  set the config word directly
  30.     :M  SETCONFIG:  put: config   ;M
  31.  
  32.     \ ( stop data parity -- )  set stop, data bits in the config word
  33.     \ stop can be 1 or 2
  34.     \ data can be 7 or 8
  35.     \ parity: 0=none 1=odd 2=even
  36.     :M  CONFIG:  { stop data parity -- }      data 7 =
  37.         IF $ 400  ELSE $ C00  THEN -> data    stop 1 =
  38.         IF $ 4000 ELSE $ C000 THEN -> stop  parity  0=
  39.         IF $ 2000
  40.         ELSE parity 1 =
  41.             IF    $ 1000
  42.             ELSE  $ 3000
  43.             THEN
  44.         THEN -> parity
  45.         get: config  $ 01FF and  data stop parity + + or
  46.         put: config   ;M
  47.  
  48.     \ set the baud rate for the port - 300,600,1200,2400, etc.
  49.     :M  BAUD: dup 300 =
  50.         IF    80 +
  51.         ELSE  300 /  380 swap / 1-
  52.         THEN  get: config  $ FE00 and  or put: config
  53.     ;M
  54.  
  55.     \ do PBControl call
  56.     :M  CONTROL:
  57.         get: direction  dup 0= swap 2 = or
  58.         IF    get: inRef  put: IORefNum  addr: header fcall PBControl drop THEN
  59.         get: direction
  60.         IF    get: outRef put: IORefNum  addr: header fcall PBControl drop THEN
  61.     ;M
  62.  
  63.     :M  STATUS: addr: header fcall PbStatus abort" status error" ;M
  64.  
  65.     :M  DTR: ( b -- fcode) get: direction dup 0= swap 2 = or classerr" 158
  66.         addr: csp1 10 erase addr: csP1 7 + c! 14 put: csCode
  67.         clear: IOComp control: self get: IOResult ;M
  68.  
  69.     \ set the communication parms from the configuration word
  70.     :M  RESET:   8 put: csCode  get: config  put: csp1  0 put: IOComp
  71.         control: self  ;M
  72.  
  73.     \ ( addr len -- RefNum )
  74.     :M  OPN: name: super open: super drop get: IORefNum  ;M
  75.  
  76.     \ ( -- )  open the read and write drivers for a port
  77.     :M  OPEN:  get: thePort  0=
  78.         IF    get: direction  dup 0= swap 2 = or
  79.             IF  " .AIn"  opn: self put: inRef  THEN
  80.             get: direction
  81.             IF  " .AOut" opn: self put: outRef THEN
  82.         ELSE  get: direction dup 0= swap 2 = or
  83.             IF  " .BIn"  opn: self put: inRef  THEN
  84.             get: direction
  85.             IF  " .BOut" opn: self put: outRef THEN
  86.         THEN get: IOResult
  87.         reset: self
  88.         get: direction IF 0 dtr: self drop THEN    \ take care dtr problem with pbooks
  89.     ;M
  90.  
  91.     \ ( addr len -- fcode )  receive LEN bytes on the serial port
  92.     :M  READ:   0 put: IOComp    get: inRef put: IORefNum    read: super  ;M
  93.  
  94.     \ ( addr len -- fcode )  send LEN bytes on the serial port
  95.     :M  WRITE:  0 put: IOComp    get: outRef put: IORefNum    write: super ;M
  96.  
  97.     \ ( cfa:proc addr len )  receive LEN bytes asynchronously on the port
  98.     :M  READNW:   get: inRef put: IORefNum    readnw: super  ;M
  99.  
  100.     \ ( cfa:proc addr len )  send LEN bytes asynchronously on the port
  101.     :M  WRITENW:  get: outRef put: IORefNum    writenw: super ;M
  102.  
  103.     \ ( -- char )  get a single character from port
  104.     :M  GET:  pad 1 read: self drop pad c@  ;M
  105.  
  106.     \ ( char -- )  send a single char to port
  107.     :M  PUT:  pad c! pad 1 write: self drop  ;M
  108.  
  109.     \ ( bool -- fcode )  turn CTS handshaking on or off via CONTROL call
  110.     :M  CTS:   addr: csp1  10 erase  put: csp1  10 put: csCode  0 put: IOComp
  111.         control: self  get: IOResult ;M
  112.  
  113.     :M  XON: ( b -- fcode) addr: csP1 c! $ 1113 put: csP2 10 put: cscode control: self
  114.         get: IOResult ;M
  115.  
  116.     \ sends out a 100 msec break
  117.     :M  BREAK: 12 put: csCode control: self 6 pause 11 put: csCode control: self ;M
  118.  
  119.     \ ( addr len -- ) increase internal buffer size from default of 64 bytes
  120.     :M  BUFFER: addr: IOBuffer w! +base addr: csP1 ! 9 put: cscode control: self ;M
  121.  
  122.     :M  BAUDRATE: ( n --) dup baud: self 13 put: cscode put: csP1 control: self ;M
  123.  
  124.     \ # of bytes in port, before reading
  125.     :M  BYTESIN: ( -- n) 2 put: cscode status: self addr: csp1 @ ;M
  126.  
  127.     :M  RECORD: ( -- ptr) global uTableBase @ -base get: ioRefNum 1+ negate 4* + @ >ptr ;M
  128.  
  129.     :M  FLAGS: ( -- n) record: self 4+ w@ ;M
  130.  
  131.     :M  ISOPEN: ( -- b) flags: self $ 20 and IF true ELSE false THEN ;M
  132.  
  133. ;CLASS
  134.